unit serveractions;

interface

uses
  Classes,
  FindFile,
  SysUtils;

type
  PSearchRec = ^TSearchRec;

  TSendBuffer = array[0..65536] of Byte;

  { TServerActions }

  TServerActions = class
  private
    FHeaders: TStrings;
    FFileStream: TFileStream;
    procedure FindAll(Path: String; Attr: Integer; List: TList);
    function GetDir(APath: string; out AOutPut: string): Boolean;
    function UploadScreen(APath: string; out AOutPut: string): Boolean;
    procedure SetFile(AFile: string);
    procedure AdSenseCode(AStr: TStrings);
    function GetImg(AFile: string; out AOutPut: string): Boolean;
    function GetCss: string;
    function HttpDecode(const AStr: String): string;
    function HTTPEncode(const AStr: String): String;
    function Search(const ASearch: string; APath: string; out AOutPut: string): Boolean;
    function AjaxSubmit: string;
  public
    destructor Destroy; override;
    function GetFilePart: TSendBuffer;
    function ExecUri(var ADirectory: string; AUri: string; out AOutPut: string;
      const AHeaders: TStrings; var AResultType: byte): Boolean;
    property FileStream: TFileStream read FFileStream;
  end;

implementation

uses
  dmImages,
  JPeg,
  Graphics,
  StrUtils;

const
  sErrorDecodingURLText = 'Error decoding URL style (%%XX) encoded string at position %d';
  sInvalidURLEncodedChar = 'Invalid URL encoded character (%s) at position %d';

{ TServerActions }

  function Reverse(S : String): String;
  var
     i : Integer;
  begin
     Result := '';
     for i := Length(S) DownTo 1 Do
       Result := Result + Copy(S,i,1) ;
  end;

  function LastPos(const SubStr: String; const S: String): Integer;
  begin
     result := Pos(Reverse(SubStr), Reverse(S)) ;

     if (result <> 0) then
       result := ((Length(S) - Length(SubStr)) + 1) - result + 1;
  end;


function CompareNames(Item1, Item2: Pointer): Integer;
begin
  Result := CompareText(PSearchRec(Item2)^.Name, PSearchRec(Item1)^.Name);
end;


procedure TServerActions.FindAll(Path: String; Attr: Integer; List: TList) ;
var
  Res: TSearchRec;
  lPRes: PSearchRec;
  EOFound: Boolean;

begin
  EOFound:= False;
  {$ifdef win32}
  Path := StringReplace('.' + Path, '/', '\', [rfReplaceAll]);
  {$endif}
  if FindFirst(Path, Attr, Res) < 0 then
    exit
  else
    while not EOFound do
    begin
      if Res.Name <> '.' then
      begin
        New(lPRes);
        lPRes^.Time := Res.Time;
        lPRes^.Size := Res.Size;
        lPRes^.Attr := Res.Attr;
        lPRes^.Name := Res.Name;
        List.Add(lPRes);
      end;
      EOFound:= FindNext(Res) <> 0;
    end;
  List.Sort(CompareNames);
  FindClose(Res) ;
end;

function TServerActions.GetDir(APath: string;
  out AOutPut: string): Boolean;
var
  lResult: TStrings;
  lDirectory: TList;
  I: Integer;
  lPath: string;
  lFile: string;
  lEvenOdd: string;
  lIsDirectory: Boolean;
begin
  try
    Result := False;
    lIsDirectory := False;
    lResult := TStringList.Create;
    lDirectory := TList.Create;
    lResult.Add('<html>');
    lResult.Add(getCss);
    lResult.Add('<body>');
    AdSenseCode(lResult);

    lResult.Add('<table class="sort-table" id="table-1" cellspacing="0">');

    lResult.Add('<form method="get">');
    lResult.Add('<thead>');
    lResult.Add('<tr>');
    lResult.Add('<td colspan="5" align="center">');
    lResult.Add('<I>You are using FileSharer. Do you like it? <a href="http://code.google.com/p/filesharer/"><b>download it from here</b></a></I>');
    lResult.Add('</td>');
    lResult.Add('</tr>');
    lResult.Add('</thead>');

    lResult.Add('<thead>');
    lResult.Add('<tr>');
    lResult.Add('<td bgcolor="#CCCCFF" colspan="4">');
    lResult.Add('<input type="button" name="search" value="Search" onClick="javascript:location.href=''/search?' + APath + '''">');
    lResult.Add('<input type="button" name="upload" value="Upload" onClick="javascript:location.href=''/uploadscreen?' + APath + '''">');
    lResult.Add('</td>');
    lResult.Add('</tr>');
    lResult.Add('</thead>');

    lResult.Add('<thead>');
    lResult.Add('<tr>');
    lResult.Add('<td align="center" width="2">&nbsp;</td>');
    lResult.Add('<td align="center" width="408">File</td>');
    lResult.Add('<td align="center" width="130">Size (in bytes)</td>');
    lResult.Add('<td align="center" width="150">Modified</td>');
    lResult.Add('</tr>');
    lResult.Add('</thead>');

    FindAll(APath + '/*.*', faAnyFile, lDirectory);
    while lDirectory.Count > 0 do
    begin
      lIsDirectory := False;
      if (lDirectory.Count mod 2) = 0 then
        lEvenOdd := 'Even'
      else
        lEvenOdd := 'Odd';

      lPath := APath;
      lResult.Add('<tr>');
      (* Directory *)
      lFile := PSearchRec(lDirectory[lDirectory.Count - 1])^.Name;
      if (PSearchRec(lDirectory[lDirectory.Count - 1])^.attr and faDirectory) = faDirectory then
      begin
        lResult.Add('<td>');
        lResult.Add('<img src="images/folder.jpg">');
        lResult.Add('</td>');

        if (lFile = '..') then
        begin
          lIsDirectory := True;
          if APath <> '' then
            lPath := Copy(APath, 0, LastPos('/', APath) - 1);
          if lPath = '' then
            lPath := '/';
        end
        else
          lPath := APath + '/' + lFile;


        lResult.Add('<td class="'+ lEvenOdd +'">');
        if Length(lFile) <= 55 then
          lResult.Add(Format('<a href="%s"><b>%.55s</b></a>', [lPath, lFile]))
        else
          lResult.Add(Format('<a href="%s"><b>%.55s..</b></a>', [lPath, lFile]))
      end
      else
      begin
        lResult.Add('<td>');
        lResult.Add('<img src="images/file.jpg">');
        lResult.Add('</td>');

        lResult.Add('<td class="'+ lEvenOdd +'">');
        if Length(lFile) <= 55 then
          lResult.Add(Format('  <a href="/download?%s">%.55s</a>', [lPath + '/' + HttpEncode(lFile), lFile]))
        else
          lResult.Add(Format('  <a href="/download?%s">%.55s..</a>', [lPath + '/' + HttpEncode(lFile), lFile]))
      end;
      lResult.Add('</td>');
      (* Size *)
      lResult.Add('<td align="right" class="'+ lEvenOdd +'">');
      lResult.Add(Format('%d',
        [PSearchRec(lDirectory[lDirectory.Count - 1])^.Size]));
      lResult.Add('</td>');

      (* Time *)
      lResult.Add('<td class="'+ lEvenOdd +'">');
      if (lIsDirectory) or (PSearchRec(lDirectory[lDirectory.Count - 1])^.Name = '') then
        lResult.Add('&nbsp;')
      else
        lResult.Add(DateTimeToStr(FileDateToDateTime(PSearchRec(lDirectory[lDirectory.Count - 1])^.Time)));
      lResult.Add('</td>');
      lResult.Add('</tr>');
      lDirectory.Delete(lDirectory.Count - 1);
    end;
    lResult.Add('</table>');
    lResult.Add('<input type="hidden" name="path" value="' + APath + '">');
    lResult.Add('</form>');

    lResult.Add('</body></html>');
    AOutPut := lResult.Text;
    FHeaders.Add('Content-type: Text/Html');
    FHeaders.Add('Content-length: ' + IntTostr(Length(AOutPut)));
    Result := True;
  finally
    lDirectory.Free;
    lResult.Free;
  end;
end;

function TServerActions.ExecUri(var ADirectory: string; AUri: string;
  out AOutPut: string; const AHeaders: TStrings; var AResultType: byte): Boolean;
var
  lSearch: string;
  lDir: string;
begin
 Result := False;
 AHeaders.Clear;
 FHeaders := AHeaders;
 SetCurrentDir(ADirectory);
 if UpperCase(AUri) = '/' then
 begin
   Result := GetDir('', AOutPut);
   AResultType := 0;
 end
 else
 if Pos('/DOWNLOAD?', UpperCase(AUri)) > 0 then
 begin
   AResultType := 1;
   AUri := HttpDecode(AUri);
   SetFile(Copy(AUri, Pos('/DOWNLOAD?', UpperCase(AUri)) + 10, Length(Auri)));
 end
 else
 if Pos('/IMAGES/', UpperCase(AUri)) > 0 then
 begin
   AResultType := 1;
   Result := GetImg(Copy(AUri, Pos('/IMAGES/', UpperCase(AUri)) + 8, Length(Auri)),
     AOutPut);
 end
 else
 if '/UPLOADING' = UpperCase(AUri) then
 begin
   Result := GetDir(ADirectory, AOutPut);
   AResultType := 0;
 end
 else
 if Pos('/UPLOADSCREEN', UpperCase(AUri)) > 0 then
 begin
   AUri := HTTPDecode(AUri);
   AUri := Copy(AUri, Pos('?', AUri) + 1, Length(AUri));
   Result := UploadScreen(AUri, AOutPut);
   AResultType := 0;
 end
 else
 if Pos('/UPLOAD', UpperCase(AUri)) > 0 then
 begin
   Result := GetDir(ADirectory, AOutPut);
   AResultType := 0;
 end
 else
 if Pos('/SEARCH', UpperCase(AUri)) > 0 then
 begin
   AUri := HttpDecode(AUri);
   lSearch := Copy(AUri, Pos('/SEARCH?', UpperCase(AUri)) + 8, Length(Auri));
   if Pos('&', lSearch) > 0 then
   begin
     lDir := Copy(lSearch, Pos('&', lSearch) + 1, length(lSearch));
     lDir := Copy(lDir, Pos('=', lDir) + 1, Length(lDir));
     if lDir = '' then
       lDir := '\';
     //lDir := ADirectory + lDir;
     lSearch := Copy(lSearch, 0, Pos('&', lSearch) - 1);
     lSearch := Copy(lSearch, Pos('=', lSearch) + 1, Length(lSearch));
   end
   else
   begin
     lDir := lSearch;
     lSearch := '';
   end;

   Result := Search(lSearch, lDir, AOutPut);
   AResultType := 0;
 end
 else
 begin
   (* Navigate *)
   AUri := HTTPDecode(AUri);
   Result := GetDir(AUri, AOutPut);
   AResultType := 0;
 end;

end;

function TServerActions.Search(const ASearch: string; APath: string; out AOutPut: string): Boolean;
var
  lResult: TStrings;
  I: Integer;
  lPath: string;
  lFile: string;
  lEvenOdd: string;
  lFindFile: TFindFile;
  lStr: TStringList;
begin
  try
    Result := False;
    lResult := TStringList.Create;
    lResult.Add('<html>');
    lResult.Add(getCss);
    lResult.Add('<body>');
    AdSenseCode(lResult);
    lResult.Add('<table class="sort-table" id="table-1" cellspacing="0">');

    lResult.Add('<form method="get" action="/search">');
    lResult.Add('<thead>');
    lResult.Add('<tr>');
    lResult.Add('<td colspan="2" align="center">');
    lResult.Add('<I>You are using FileSharer. Do you like it? <a href="http://code.google.com/p/filesharer/"><b>download it from here</b></a></I>');
    lResult.Add('</td>');
    lResult.Add('</tr>');
    lResult.Add('</thead>');

    lResult.Add('<thead>');
    lResult.Add('<tr>');
    lResult.Add('<td bgcolor="#CCCCFF" colspan="2">');

    lResult.Add('<input type="text" name="searchtext" size="80" value="' + ASearch + '">');
    lResult.Add('<input type="hidden" name="path" value="' + APath + '">');
    lResult.Add('<input type="submit" value="Search">');
    lResult.Add('<input type="button" value="Back" OnClick="JavaScript:location.href=''' + APath + '''">');
    lResult.Add('</td>');
    lResult.Add('</tr>');
    lResult.Add('</thead>');

    if ASearch <> '' then
    begin
      lResult.Add('<thead>');
      lResult.Add('<tr>');
      lResult.Add('<td align="center" width="2">&nbsp;</td>');
      lResult.Add('<td align="center" width="726">File</td>');
      lResult.Add('</tr>');
      lResult.Add('</thead>');

      lFindFile := TFindFile.Create(nil);
      try
        lFindFile.FileAttr := [ffaArchive];
        lFindFile.InSubFolders := True;
        lFindFile.Path := GetCurrentDir + APath ;
        lFindFile.FileMask := '*' + ASearch + '*.*';
        lStr := lFindFile.SearchForFiles;
        for I := 0 to lStr.Count - 1 do
        begin

          if (I mod 2) = 0 then
            lEvenOdd := 'Even'
          else
            lEvenOdd := 'Odd';

          lPath := '';
          lResult.Add('<tr>');
          (* Directory *)
          lFile := lStr[I];
          {$ifdef win32}
          lFile := StringReplace(lFile, '\', '/', [rfReplaceAll]);
          {$endif}

          lResult.Add('<td>');
          lResult.Add('<img src="images/file.jpg">');
          lResult.Add('</td>');

          lResult.Add('<td class="'+ lEvenOdd +'">');
          lFile := copy(lFile, Length(GetCurrentDir) + 1, Length(lFile));
          if Length(lFile) <= 120 then
            lResult.Add(Format('  <a href="/download?%s">%.120s</a>', [HttpEncode(lFile), lFile]))
          else
            lResult.Add(Format('  <a href="/download?%s">%.120s..</a>', [HttpEncode(lFile), lFile]));
          lResult.Add('</td>');
           lResult.Add('</tr>');
        end;
      finally
        lFindFile.Free;
      end;
    end;

    lResult.Add('</table>');
    lResult.Add('</form>');

    lResult.Add('</body></html>');
    AOutPut := lResult.Text;
    FHeaders.Add('Content-type: Text/Html');
    FHeaders.Add('Content-length: ' + IntTostr(Length(AOutPut)));
    Result := True;
  finally
    lResult.Free;
  end;
end;

procedure TServerActions.SetFile(AFile: string);
begin
  AFile := '.' + HttpDecode(AFile);
  FFileStream := TFileStream.Create(AFile, fmOpenRead);
  AFile := Copy(AFile, LastPos('/', AFile) + 1, Length(AFile) - LastPos('/', AFile) + 1);
  FHeaders.Add('Content-type: application/force-download');
  FHeaders.Add('Content-Length: ' + IntToStr(FFileStream.Size));
  FHeaders.Add('Content-Disposition: attachment; filename="' + AFile + '";' );
end;

function TServerActions.UploadScreen(APath: string;
  out AOutPut: string): Boolean;
var
  lResult: TStrings;
  I: Integer;
  lPath: string;
  lFile: string;
  lEvenOdd: string;
  lFindFile: TFindFile;
  lStr: TStringList;
begin
  try
    Result := False;
    lResult := TStringList.Create;
    lResult.Add('<html>');
    lResult.Add(getCss);
    lResult.Add(AjaxSubmit);
    lResult.Add('<body>');

    AdSenseCode(lResult);

    lResult.Add('<table class="sort-table" id="table-1" cellspacing="0">');

    lResult.Add('<form enctype="multipart/form-data" method="post" action="/upload" onsubmit="return AIM.submit(this, {''onStart'' : startCallback, ''onComplete'' : completeCallback})">');
    lResult.Add('<thead>');
    lResult.Add('<tr>');
    lResult.Add('<td colspan="5" align="center">');
    lResult.Add('<I>You are using FileSharer. Do you like it? <a href="http://code.google.com/p/filesharer/"><b>download it from here</b></a></I>');
    lResult.Add('</td>');
    lResult.Add('</tr>');
    lResult.Add('</thead>');

    lResult.Add('<thead>');
    lResult.Add('<tr>');
    lResult.Add('<td bgcolor="#CCCCFF" colspan="5" width="690">');
    lResult.Add('<input type="file" name="file" size="60">');
    lResult.Add('<input type="hidden" name="path" value="' + APath + '">');
    lResult.Add('<input type="submit" value="Upload">');
    lResult.Add('</td>');
    lResult.Add('</tr>');
    lResult.Add('</thead>');

    lResult.Add('</table>');
    lResult.Add('</form>');

    lResult.Add('<div><span id="r">0</span></div>');

    lResult.Add('</body></html>');
    AOutPut := lResult.Text;
    FHeaders.Add('Content-type: Text/Html');
    FHeaders.Add('Content-length: ' + IntTostr(Length(AOutPut)));
    Result := True;
  finally
    lResult.Free;
  end;
end;

function TServerActions.GetImg(AFile: string;
  out AOutPut: string): Boolean;
var
  lBitmap: TBitMap;
  lJpeg: TJPEGImage;
  lStream: TMemoryStream;
begin
  Result := False;
  lJPeg := TJPEGImage.Create;
  lBitmap := TBitmap.Create;
  lStream := TMemoryStream.Create;
  try
    if UpperCase(AFile) = 'FOLDER.JPG' then
      ImagesDataModule.ImageList1.GetBitmap(0, lBitmap)
    else
      ImagesDataModule.ImageList1.GetBitmap(1, lBitmap);

    AOutPut := '';
    lJpeg.Assign(lBitmap);
    lJpeg.SaveToStream(lStream);
    SetLength( AOutPut, lStream.Size);
    lStream.Position := 0;
    lStream.Read( AOutPut[1], Length(AOutPut));
    FHeaders.Clear;
    FHeaders.Add('Content-type: image/jpeg');
    FHeaders.Add('Content-Length: ' + IntToStr(lStream.Size));
    FHeaders.Add('Content-Disposition: attachment; filename="' + AFile + '";' );
    Result := AOutPut <> '';
  finally
    lStream.Free;
    lJPeg.Free;
    lBitmap.Free;
  end;
end;

function TServerActions.GetCss: string;
begin
  Result :=
  '<style>' +
  '.sort-table {' +
  '  font:		Icon;' +
  '  border:		1px Solid ThreeDShadow;' +
  '  background:	Window;' +
  '  color:		WindowText;' +
  '  font-family: arial, helvetica, sans-serif; ' +
  '  font-size: 11px; ' +
  '}' +
  '.sort-table thead {' +
  '  background:	ButtonFace;' +
  '}' +
  '.sort-table td {      ' +
  '  padding:	2px 5px;' +
  '}' +
  '.sort-table thead td {' +
  '  border:			1px solid;' +
  '  border-color:	ButtonHighlight ButtonShadow' +
  '          ButtonShadow ButtonHighlight;' +
  '  cursor:			default;' +
  '}' +
  '.even {' +
  '	background:	#eee;' +
  '}' +
  '.odd {' +
  '} ' +
  'body {' +
	'  font-family:	Verdana, Helvetica, Arial, Sans-Serif;' +
	'  font:			Message-Box; ' +
  ' } ' +
  '</style>';
end;

function TServerActions.HTTPEncode(const AStr: String): String;
const
  NoConversion = ['A'..'Z','a'..'z','*','@','.','_','-'];
var
  Sp, Rp: PChar;
begin
  SetLength(Result, Length(AStr) * 3);
  Sp := PChar(AStr);
  Rp := PChar(Result);
  while Sp^ <> #0 do
  begin
    if Sp^ in NoConversion then
      Rp^ := Sp^
    else
      if Sp^ = ' ' then
        Rp^ := '+'
      else
      begin
        FormatBuf(Rp^, 3, '%%%.2x', 6, [Ord(Sp^)]);
        Inc(Rp,2);
      end;
    Inc(Rp);
    Inc(Sp);
  end;
  SetLength(Result, Rp - PChar(Result));
end;

function TServerActions.HttpDecode(const AStr: String): string;
var
  Sp, Rp, Cp: PChar;
  S: String;
begin
  SetLength(Result, Length(AStr));
  Sp := PChar(AStr);
  Rp := PChar(Result);
  Cp := Sp;
  try
    while Sp^ <> #0 do
    begin
      case Sp^ of
        '+': Rp^ := ' ';
        '%': begin
               // Look for an escaped % (%%) or %<hex> encoded character
               Inc(Sp);
               if Sp^ = '%' then
                 Rp^ := '%'
               else
               begin
                 Cp := Sp;
                 Inc(Sp);
                 if (Cp^ <> #0) and (Sp^ <> #0) then
                 begin
                   S := '$' + Cp^ + Sp^;
                   Rp^ := Chr(StrToInt(S));
                 end
                 else
                   raise Exception.CreateFmt(sErrorDecodingURLText, [Cp - PChar(AStr)]);
               end;
             end;
      else
        Rp^ := Sp^;
      end;
      Inc(Rp);
      Inc(Sp);
    end;
  except
    on E:EConvertError do
      raise EConvertError.CreateFmt(sInvalidURLEncodedChar,
        ['%' + Cp^ + Sp^, Cp - PChar(AStr)])
  end;
  SetLength(Result, Rp - PChar(Result));
end;

function TServerActions.GetFilePart: TSendBuffer;
var
  lSize: cardinal;
begin
  if (FFileStream.Position + SizeOf(Result)) <= FFileStream.Size then
    lSize := SizeOf(Result)
  else
    lSize := FFileStream.Size - FFileStream.Position;
    FFileStream.ReadBuffer(Result, lSize)
end;

destructor TServerActions.Destroy;
begin
  FFileStream.Free;
  inherited;
end;

procedure TServerActions.AdSenseCode(AStr: TStrings);
begin
  (* AdSense *)
  AStr.Add('<script type="text/javascript"><!--');
  AStr.Add('google_ad_channel = "9587763620+6626133373+5071072465+2906494158+9734562735";');
  AStr.Add('google_ad_client = "pub-8940640275464591";');
  AStr.Add('google_ad_width = 728;');
  AStr.Add('google_ad_height = 90;');
  AStr.Add('google_ad_format = "728x90_as";');
  AStr.Add('google_ad_type = "text_image";');
  AStr.Add('google_ad_channel = "";');
  AStr.Add('//-->');
  AStr.Add('</script>');
  AStr.Add('<script type="text/javascript"');
  AStr.Add('  src="http://pagead2.googlesyndication.com/pagead/show_ads.js">');
  AStr.Add('</script>');
end;

function TServerActions.AjaxSubmit: string;
begin
  Result :=
    '<script type="text/javascript"> ' +
    'AIM = { ' +
    '        frame : function(c) { ' +
    '            var n = ''f'' + Math.floor(Math.random() * 99999); ' +
    '            var d = document.createElement(''DIV''); ' +
    '            d.innerHTML = ''<iframe style="display:none" src="about:blank" id="''+n+''" name="''+n+''" onload="AIM.loaded(\''+n+\'')"></iframe>''; ' +
    '            document.body.appendChild(d); ' +
    '            var i = document.getElementById(n); ' +
    '            if (c && typeof(c.onComplete) == ''function'') { ' +
    '                i.onComplete = c.onComplete; ' +
    '            } ' +
    '            return n; ' +
    '        }, ' +
    '        form : function(f, name) { ' +
    '            f.setAttribute(''target'', name); ' +
    '        }, ' +
    '        submit : function(f, c) { ' +
    '            AIM.form(f, AIM.frame(c)); ' +
    '            if (c && typeof(c.onStart) == ''function'') { ' +
    '                return c.onStart(); ' +
    '            } else { ' +
    '                return true; ' +
    '            } ' +
    '        }, ' +
    '        loaded : function(id) { ' +
    '            var i = document.getElementById(id); ' +
    '            if (i.contentDocument) { ' +
    '                var d = i.contentDocument; ' +
    '            } else if (i.contentWindow) { ' +
    '                var d = i.contentWindow.document; ' +
    '            } else { ' +
    '                var d = window.frames[id].document; ' +
    '            }' +
    '            if (typeof(i.onComplete) == ''function'') { ' +
    '                i.onComplete(d.body.innerHTML); ' +
    '            } ' +
    '        } ' +
    '    }; ' +
    'function startCallback() { ' + #13 +
    '    document.getElementById(''r'').innerHTML = "Uploading..."; ' + #13 +
    '    return true; ' + #13 +
    '    } ' +
    'function completeCallback(response) { ' +
    '    alert("ok"); ' +
    '    document.getElementById(''r'').innerHTML = "Ok."; ' + #13 +
    '    } ' +
    '</script>';
end;

end.
